Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/internet/cswsk110/telnet.frm

Text File | 1995-12-07 | 9KB | 310 lines

VERSION 2.00
Begin Form Form1
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Telnet"
   ClientHeight    =   4395
   ClientLeft      =   1860
   ClientTop       =   1830
   ClientWidth     =   7080
   FontBold        =   0   'False
   FontItalic      =   0   'False
   FontName        =   "Courier New"
   FontSize        =   8.25
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   4800
   Left            =   1800
   LinkTopic       =   "Form1"
   ScaleHeight     =   4395
   ScaleWidth      =   7080
   Top             =   1485
   Width           =   7200
   Begin TextBox PortName
      Height          =   285
      Left            =   4920
      TabIndex        =   3
      Text            =   "telnet"
      Top             =   360
      Width           =   975
   End
   Begin TextBox Hostname
      Height          =   285
      Left            =   1080
      TabIndex        =   1
      Top             =   360
      Width           =   2415
   End
   Begin CommandButton Command1
      Caption         =   "Connect"
      Height          =   375
      Left            =   3000
      TabIndex        =   5
      Top             =   3840
      Width           =   1335
   End
   Begin Socket Socket1
      Backlog         =   1
      Binary          =   -1  'True
      Blocking        =   -1  'True
      Broadcast       =   0   'False
      BufferSize      =   0
      HostAddress     =   ""
      HostFile        =   ""
      HostName        =   ""
      InLine          =   0   'False
      Interval        =   0
      KeepAlive       =   0   'False
      Left            =   240
      Linger          =   0
      LocalPort       =   0
      LocalService    =   ""
      Peek            =   0   'False
      Protocol        =   0
      RecvLen         =   0
      RemotePort      =   0
      RemoteService   =   ""
      ReuseAddress    =   0   'False
      Route           =   -1  'True
      SendLen         =   0
      TabIndex        =   6
      Timeout         =   0
      Top             =   3840
      Type            =   1
      Urgent          =   0   'False
   End
   Begin TextBox TextBox
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Courier New"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   2655
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   4
      Top             =   960
      Width           =   6735
   End
   Begin Label Label2
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "&Port:"
      Height          =   195
      Left            =   4320
      TabIndex        =   2
      Top             =   360
      Width           =   420
   End
   Begin Label Label1
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "&Hostname:"
      Height          =   195
      Left            =   120
      TabIndex        =   0
      Top             =   360
      Width           =   915
   End
End
Option Explicit

Const TELCMD_IAC = 255
Const TELCMD_DONT = 254
Const TELCMD_DO = 253
Const TELCMD_WONT = 252
Const TELCMD_WILL = 251
Const TELCMD_SB = 250
Const TELCMD_NOP = 241
Const TELCMD_SE = 240

Const TELOPT_BINARY = 0
Const TELOPT_ECHO = 1
Const TELOPT_TTYPE = 24

Const TELQUAL_IS = 0
Const TELQUAL_SEND = 1

Sub Command1_Click ()
    If Socket1.Connected Then
    Command1.Enabled = False
    Socket1.Shutdown = 1
    Else
    HostName.Text = Trim$(HostName.Text)
    PortName.Text = Trim$(PortName.Text)

    If Len(HostName.Text) = 0 Then
        MsgBox "No host name specified"
        HostName.SetFocus
        Exit Sub
    End If

    Socket1.AddressFamily = AF_INET
    Socket1.Protocol = IPPROTO_TCP
    Socket1.Type = SOCK_STREAM
    Socket1.LocalPort = IPPORT_ANY
    Socket1.RemotePort = IPPORT_TELNET
    Socket1.Binary = True
    Socket1.BufferSize = 1024
    Socket1.Blocking = False

    On Error Resume Next
    Screen.MousePointer = 11 ' Hourglass
    Command1.Enabled = False

    Socket1.HostName = HostName.Text
    If Err <> 0 Then
        Screen.MousePointer = 0 'Default
        Command1.Enabled = True
        HostName.SetFocus
        Exit Sub
    End If

    If Len(PortName.Text) > 0 Then
        Socket1.RemoteService = PortName.Text
        If Err <> 0 Then
        Screen.MousePointer = 0 'Default
        Command1.Enabled = True
        PortName.SetFocus
        Exit Sub
        End If
    End If

    Socket1.Action = SOCKET_CONNECT
    Screen.MousePointer = 0 ' Default
    End If
End Sub

Sub Form_Load ()
    TextBox.Enabled = False: Command1.Default = True
End Sub

Sub Form_Unload (Cancel As Integer)
    If Socket1.Connected Then Socket1.Action = SOCKET_CLOSE
    End
End Sub

Sub Socket1_Close ()
    Socket1.Action = SOCKET_CLOSE
    Form1.Caption = "Telnet"
    TextBox.Text = ""
    TextBox.Enabled = False
    Command1.Caption = "Connect"
    Command1.Enabled = True
    Command1.Default = True
End Sub

Sub Socket1_Connect ()
    Screen.MousePointer = 0 ' Normal
    Command1.Caption = "Disconnect"
    Command1.Enabled = True
    Command1.Default = False
    TextBox.Enabled = True
    TextBox.SetFocus
    If Len(Socket1.PeerName) > 0 Then Form1.Caption = Socket1.PeerName
End Sub

Sub Socket1_Error (ErrCode As Integer, ErrMsg As String, Response As Integer)
    MsgBox ErrMsg, 48, Form1.Caption
End Sub

Sub Socket1_Read (DataLength As Integer, IsUrgent As Integer)
    Dim sBuffer As String, sOutput As String, sReply As String
    Dim nRead As Integer, nIndex As Integer, nChar As Integer
    Dim nCmd As Integer, nOpt As Integer, nQual As Integer

    Socket1.RecvLen = DataLength
    sBuffer = Socket1.RecvData: nRead = Socket1.RecvLen

    nIndex = 1
    While nIndex <= nRead
    nChar = Asc(Mid$(sBuffer, nIndex, 1))
    '
    ' If this is the Telnet IAC (Is A Command) character, then
    ' the next byte is the command
    '
    If nChar = TELCMD_IAC Then
        nIndex = nIndex + 1: nCmd = Asc(Mid$(sBuffer, nIndex, 1))
        Select Case nCmd
        '
        ' Two IAC bytes means that this isn't really a command
        '
        Case TELCMD_IAC
        sOutput = sOutput + Chr$(nChar)
        '
        ' The SB (sub-option) command tells us that the server
        ' wants to negotiate. In this case, the only sub-option
        ' that we will deal with is the terminal type
        '
        Case TELCMD_SB
        nIndex = nIndex + 1: nOpt = Asc(Mid$(sBuffer, nIndex, 1))
        nIndex = nIndex + 1: nQual = Asc(Mid$(sBuffer, nIndex, 1))
        If nOpt = TELOPT_TTYPE Then
            '
            ' Build a sub-option reply string and send it to
            ' the server. In this case, we're saying that we are
            ' a DEC VT100 terminal
            '
            sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_SB) + Chr$(nOpt) + Chr$(TELQUAL_IS) + "DEC-VT100" + Chr$(TELCMD_IAC) + Chr$(TELCMD_SE)
            Socket1.SendLen = Len(sReply): Socket1.SendData = sReply
        End If
        '
        ' The DO, DONT, WILL and WONT commands are sent by the server
        ' to tell us what it is capable (or not capable) of, and the
        ' options that it would like us to use; the next byte is the
        ' option code
        '
        Case TELCMD_DO, TELCMD_DONT, TELCMD_WILL, TELCMD_WONT
        nIndex = nIndex + 1: nOpt = Asc(Mid$(sBuffer, nIndex, 1))
        Select Case nOpt
        '
        ' The only options that we'll deal with is binary mode,
        ' echo and terminal type
        '
        Case TELOPT_BINARY, TELOPT_ECHO, TELOPT_TTYPE
            If nCmd = TELCMD_DO Then
            sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_WILL) + Chr$(nOpt)
            Socket1.SendLen = 3: Socket1.SendData = sReply
            ElseIf nCmd = TELCMD_WILL Then
            sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_DO) + Chr$(nOpt)
            Socket1.SendLen = 3: Socket1.SendData = sReply
            End If
        '
        ' For anything else, tell the server that we wont
        ' support it, or don't want the server to
        '
        Case Else
            If nCmd = TELCMD_DO Then
            sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_WONT) + Chr$(nOpt)
            Socket1.SendLen = 3: Socket1.SendData = sReply
            ElseIf nCmd = TELCMD_WILL Then
            sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_DONT) + Chr$(nOpt)
            Socket1.SendLen = 3: Socket1.SendData = sReply
            End If
        End Select
        End Select
    Else
        sOutput = sOutput + Chr$(nChar)
    End If
    nIndex = nIndex + 1
    Wend

    '
    ' Append the output to the edit control
    '
    If Len(sOutput) > 0 Then
    TextBox.SelStart = 65535: TextBox.SelLength = 0
    TextBox.SelText = sOutput
    End If
End Sub

Sub TextBox_KeyPress (KeyAscii As Integer)
    If Socket1.Connected Then
    If KeyAscii = 13 Then KeyAscii = 10
    Socket1.SendLen = 1: Socket1.SendData = Chr$(KeyAscii)
    End If
    KeyAscii = 0
End Sub